;;########################################################################
;; pcavis.lsp
;; visualization method for principal components ViSta model object
;; Copyright (c) 1991-98 by Forrest W. Young
;;########################################################################


(defmeth pca-model-object-proto :visualize ()
  (if (not (eq current-object self)) (setcm self))
  (let* ((scores (send self :scores))
         (coefs  (send self :coefs))
         (coefs (* (/ coefs (max (abs (combine coefs)))) (max (abs (combine scores)))))
                      
         (nvar (send self :nvar))
         (ndim (min nvar 5))
         (nobs (send self :nobs))
         (score-cols (select (column-list scores) (iseq ndim)))
         (pca-labels (select '("PC1" "PC2" "PC3" "PC4" "PC5") 
                             (iseq ndim)))
         #|(rays (row-list (select (transpose (send self :coefs) )
                                  (iseq ndim) (iseq nvar))))|#
         (rays (row-list (select (transpose coefs )
                                  (iseq ndim) (iseq nvar))))
         (point-labels (send self :labels))
         (variable-labels (send self :variables))
         (evals (send current-model :eigenvalues))
         (proportions (/ evals (sum evals)))
         (scatmat 
          (if (> nvar 2)
              (scatterplot-matrix score-cols
                                  :point-labels point-labels
                                  :variable-labels pca-labels
                                  :show nil)
              nil))
         (spin-plot 
          (if (> nvar 2)
              (spin-plot score-cols 
                         :point-labels point-labels
                         :variable-labels pca-labels
                         :title "Spinning BiPlot"
                         :show nil)
              nil))
         (scatterplot (plot-points score-cols 
                              :point-labels point-labels
                              :variable-labels pca-labels
                              :title "BiPlot"
                              :show nil))
         (boxplot (boxplot score-cols
                              :variable-labels pca-labels
                              :point-labels point-labels
                              :connect-points t
                              :show nil))
         (scree (scree-plot proportions :show nil))
         (obs-list (name-list point-labels :show nil))
         (sp (spread-plot 
              (if (> nvar 2)
                  (matrix '(2 3)
                          (list scatmat  spin-plot scatterplot
                                obs-list boxplot   scree))
                  (matrix '(2 2) (list scatterplot boxplot  
                                       obs-list scree)))))
         (dimension-lengths nil)
         (rays-mat nil)
         (vector-lengths nil)
         (spin-vector-ratio nil)
         )

    (defmeth sp :spreadplot-help ()
      (plot-help-window (strcat "SpreadPlot Help"))
      (paste-plot-help (format nil "This is the SpreadPlot for Principal Component Analysis. In this SpreadPlot the windows are linked by the data's observations and variables as well as by the Principal Components.~2%"))
      (when (> nvar 2) 
            (paste-plot-help (format nil "The Scatterplot Matrix window, which is in the upper left corner, lets you choose which Principal Components are displayed in other windows. "))
            (paste-plot-help (format nil "You can select a single Principal Component by clicking on a diagonal cell in this matrix, or you can select two Principal Components by clicking on an off-diagonal cell. You can also select several Principal Components by shift-clicking on several cells.~2%")))
(paste-plot-help (format nil "The Points and Vectors window, at the lower left, presents labels for both observations and variables. Selecting labels will cause points and vectors in the other plots to be highlighted.~2%"))
(paste-plot-help (format nil
"The points and vectors in the windows of this spreadplot are linked together. When you brush or click on them in one window, the corresponding points or vectors in other windows are also highlighted. The points are linked together because they represent the same observations in your data. The vectors are linked because they represent the same varibles. By looking for the structure revealed in each window you can get a better understanding of your data.~2%"))
      (show-plot-help)
      (call-next-method :skip t :flush nil))

;=-=-=-=-= scatmat

    (when (> nvar 2)
          (send scatmat :linked t)
          (send scatmat :add-mouse-mode 'focus-on-variables
                :title "Focus On Variables"
                :click :do-new-variable-focus
                :cursor 'finger)
          (send scatmat :mouse-mode 'focus-on-variables)
          (send scatmat :plot-buttons :new-x nil :new-y nil)
          (send scatmat :use-color t)
          (send scatmat :point-color (iseq nobs) 'blue)
          (send scatmat :menu-template 
                '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH SYMBOL COLOR ))
          (send scatmat :new-menu)
          
          ;LINK, ERASE-SELECTION, FOCUS-ON-SELECTION, and SHOW-ALL removed 
          ;from each plot's menu because they dont work with boxplot

          (defmeth scatmat :update-plotcell (i j args)
            (when (and (= i 1) (= j 1))
                  (send self :point-state (iseq (send self :num-points))
                        (first args))))

          (defmeth scatmat :adjust-points-in-rect (&rest args)
            (apply #'call-next-method args)
            (send sp :update-spreadplot 
                  0 4 (send self :point-state (iseq nobs)) (send self :mouse-mode))
            )

          (defmeth scatmat :do-brush-click (&rest args)
            (send sp :update-spreadplot 0 4 nil 0)
            (apply #'call-next-method args)
            )
          
          (defmeth scatmat :set-selection-color ()
            (call-next-method)
            (send self :point-color (first (send self :selection)))
            (send sp :update-spreadplot 0 4 (send self :point-state (iseq nobs)) 
                  'color
                  (send self :point-color (first (send self :selection)))))
          
          (defmeth scatmat :set-selection-symbol ()
            (call-next-method)
            (send self :point-color (first (send self :selection)))
            (send sp :update-spreadplot 0 4 (send self :point-state (iseq nobs)) 
                  'symbol
                  (send self :point-symbol (first (send self :selection)))))
          
;=-=-=-=-= spin-plot

          ;(send spin-plot :depth-cuing nil)
          (send spin-plot :scale-type 'fixed);xls bug work-around
          (send spin-plot :point-symbol 
                (iseq (send spin-plot :num-points)) 'disk)
          (send spin-plot :point-color (iseq nobs) 'blue)
          (send spin-plot :mouse-mode 'hand-rotate)
          (send spin-plot :scale-constant 1.5 :draw nil)
          (send spin-plot :scale-type 'centroid-fixed)
          (send spin-plot :linked t)
          (send spin-plot :showing-labels t)
          (send spin-plot :menu-template 
                '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH 
                                 SYMBOL COLOR line-width DASH FASTER SLOWER AXES ))
          (send spin-plot :new-menu)
          (send spin-plot :add-box)
          (send spin-plot :switch-add-box)
          (setf dimension-lengths 
                (mapcar #'max (abs (send spin-plot :range (iseq ndim)))))
       #|  (setf rays-mat (matrix (list ndim nvar) (combine rays)))
          (setf vector-lengths (sqrt (mapcar #'ssq (column-list rays-mat))))
          (setf spin-vector-ratio (sqrt (/ (^ (min dimension-lengths) 2)
                                           (^ (max vector-lengths) 2))))
          (setf rays (* rays spin-vector-ratio))|#
          
          (send spin-plot :add-rays rays :ray-labels variable-labels 
                :ray-color 'red)
          
         ; (if (> (send spin-plot :num-variables) 3)
         ;     (send spin-plot :plot-buttons :margin nil :new-z t :box t)
         ;     (send spin-plot :plot-buttons :margin nil :new-x nil 
         ;           :new-y nil :box t)) 
          
          (defmeth spin-plot :add-box (&key (draw t))
            (call-next-method :draw draw)
            (send self :add-rays rays :ray-color 'red :no-points t))
          
          (defmeth spin-plot :set-line-width ()
            (let* ((box? (send self :show-box))
                   )
              (send self :ray-line-width 
                    (first (get-value-dialog "Specify Ray Line Width" 
                                             :initial (send self :ray-line-width))))
              (cond
                (box? 
                 (send self :clear-lines :draw nil)
                 (send self :add-box :draw t))
                (t
                 (send self :clear-lines :draw nil)
                 (send self :add-rays rays :ray-color 'red :no-points t)))
              ))
          
          (defmeth spin-plot :update-plotcell (i j args)
            (when (and (= i 0) (= j 0))
                  (let* ((cur-var-nums (remove-duplicates (first args)))
                         (cur-var-names (remove-duplicates 
                                         (first (second args))  :test 'equal))
                         (numvars (send self :num-variables))
                         )
                    (when (<= (length cur-var-nums) 2)
                          (setf cur-var-nums 
                                (select 
                                 (combine cur-var-nums 
                                          (set-difference (send self :current-variables)
                                                          cur-var-nums))
                                 (iseq 3)))
                          (setf cur-var-names 
                                (select (send self :variable-labels)
                                        cur-var-nums)))
                    (when (or (= (length cur-var-nums) 3)
                              (and (= (length cur-var-nums) 4)
                                   (= (third (send self :current-variables)) 
                                      (- numvars 1))))
                          (when (= (length cur-var-nums) 4)
                                (setf cur-var-nums (select cur-var-nums '(0 1 2)))
                                (setf cur-var-names 
                                      (select cur-var-names '(0 1 2)))
                                )
                          (apply #'send self  :current-variables cur-var-nums)
                          (send self :set-variables-with-labels cur-var-nums
                                cur-var-names)
                          (send self :transformation nil :draw nil)
                          (send self :add-box)
                          (when (matrixp (send self :slot-value 'rotation-type))
                                (send self :slot-value 'rotation-type 'yawing))
                          (send self :redraw)
                          )))
            
            (when (and (= i 1) (= j 1))
                  (send self :point-state (iseq nobs) (first args)))
            )

          (defmeth spin-plot :adjust-points-in-rect (&rest args)
            (apply #'call-next-method args)
            (send sp :update-spreadplot 
                  0 1 (send self :point-state (iseq nobs)) (send self :mouse-mode))
            )
          
          (defmeth spin-plot :do-brush-click (&rest args)
            (send sp :update-spreadplot 0 1 nil 0)
            (apply #'call-next-method args)
            )

          (defmeth spin-plot :set-selection-color ()
            (call-next-method)
            (send self :point-color (first (send self :selection)))
            (send sp :update-spreadplot 0 1 (send self :point-state (iseq nobs)) 
                  'color
                  (send self :point-color (first (send self :selection)))))
          
          (defmeth spin-plot :set-selection-symbol ()
            (call-next-method)
            (send self :point-color (first (send self :selection)))
            (send sp :update-spreadplot 0 1 (send self :point-state (iseq nobs)) 
                  'symbol
                  (send self :point-symbol (first (send self :selection)))))
          
          (defmeth spin-plot :show-new-var (axis variable)
            (let* ((var-num (position variable (send self :variable-labels)))
                   (cur-vars (send self :current-variables))
                   (cur-var-names nil)
                   (idling (send self :idle-on))
                   )
              (cond
                ((equal (string-downcase axis) "x") 
                 (setf (select cur-vars 0) var-num))
                ((equal (string-downcase axis) "y") 
                 (setf (select cur-vars 1) var-num))
                ((equal (string-downcase axis) "z") 
                 (setf (select cur-vars 2) var-num))
                )
              (setf cur-var-names (select (send self :variable-labels) cur-vars))
              (send self :idle-on nil)
              (send self :transformation nil)
              (apply #'send self :current-variables cur-vars)
              (send self :set-variables-with-labels cur-vars cur-var-names)
              ; (send spin-plot :add-rays rays :ray-labels variable-labels)
              (send self :redraw)
              (send self :idle-on idling)))
          
          (defmeth spin-plot :plot-help ()
            (plot-help-window (strcat "Help for " (send self :title)))
            (paste-plot-help (format nil "A Spinning Biplot is an enhanced spinning 3-dimensional scatterplot that uses both points and vectors to represent structure. The Spinning Biplot is interpreted in the same way as the (stationary) 2-dimensional Biplot. See help for the Biplot window for more details.~2%"))
            (show-plot-help)
            (call-next-method :flush nil))
          
          )
          
;=-=-=-=-= scatterplot 

    (send (send scatterplot :menu) :title "BiPlot")
    (send scatterplot :adjust-scatterplot-to-data 'centroid-fixed)
    (send scatterplot :plot-buttons)
    (send scatterplot :point-color (iseq nobs) 'blue)
    (send scatterplot :add-rays rays 
          :ray-labels variable-labels :ray-color 'red)
    (send scatterplot :add-grid)
    (send scatterplot :linked t)
    (send scatterplot :showing-labels t)
    (send scatterplot :mouse-mode 'brushing)
    (send scatterplot :menu-template 
      '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH SYMBOL COLOR dash print save copy dash line-width ))
    (send scatterplot :new-menu)
    #| (send scatterplot :scale (iseq nvar) 
            (/ (send scatterplot :scale (iseq nvar)) 1))|#
    (mapcar #'(lambda (d) (send scatterplot :range d 
                                (- (* 1.001 (max (combine scores))))
                                (* 1.001 (max (combine scores)))))
                
            (iseq ndim))
    
    (defmeth scatterplot :adjust-points-in-rect (&rest args)
       (apply #'call-next-method args)
       (send sp :update-spreadplot 
             0 2 (send self :point-state (iseq nobs)) 
             (send self :mouse-mode))
       )

    (defmeth scatterplot :do-brush-click (&rest args)
      (send sp :update-spreadplot 0 2 nil 0)
      (apply #'call-next-method args)
      )

    (defmeth scatterplot :set-selection-color ()
      (call-next-method)
      (send self :point-color (first (send self :selection)))
      (send sp :update-spreadplot 0 2 (send self :point-state (iseq nobs)) 
            'color
             (send self :point-color (first (send self :selection)))))

    (defmeth scatterplot :set-selection-symbol ()
      (call-next-method)
      (send self :point-color (first (send self :selection)))
      (send sp :update-spreadplot 0 2 (send self :point-state (iseq nobs)) 
            'symbol
             (send self :point-symbol (first (send self :selection)))))

    (defmeth scatterplot :redraw-content ()
      (call-next-method)
      (send self :add-grid))

    (defmeth scatterplot :update-plotcell (i j args)
      (when (and (= i 0) (= j 0));when coming from scatmat
            (let* ((cur-var-nums (remove-duplicates (first args))))
              (when (= (length cur-var-nums) 2)
                    (send self :current-variables 
                          (first cur-var-nums)  (second cur-var-nums) 
                          :draw nil)
                    (apply #' send self :y-axis (send self :y-axis))
                    )))
      (when (and (= i 1) (= j 1))
            (send self :point-state (iseq nobs) (first args)))
      )                          

    (defmeth scatterplot-proto :show-new-var (axis variable)
      (let* ((cur-var (send self :current-variables))
             (var-num (position variable (send self :variable-labels))))
        (if (equal axis "X") 
            (send self :current-variables var-num (second cur-var) :draw nil)
            (send self :current-variables (first cur-var) var-num :draw nil))
        (apply #' send self :y-axis (send self :y-axis))
        ;(send self :add-grid)
        (send self :redraw)))

    (defmeth scatterplot :plot-help ()
      (plot-help-window (strcat "Help for " (send self :title)))
      (paste-plot-help (format nil "A Biplot is an enhanced scatterplot that uses both points and vectors to represent structure. As used in Principal Component Analysis, the axes of a biplot are a pair of principal components. A biplot uses points to represent the scores of the observations on the principal components, and it uses vectors to represent the coefficients of the variables on the principal components.~2%"))
      (paste-plot-help (format nil "The relative location of the points can be interpreted. Points that are close together correspond to observations that have similar scores on the components displayed in the plot. To the extent that these components fit the data well, the points also correspond to observations that have similar values on the variables.~2%"))
      (paste-plot-help (format nil "Both the direction and length of the vectors can be interpreted. Vectors point away from the origin in some direction. Vectors that point in the same direction correspond to variables that have similar response profiles, and can be interpreted as having similar meaning in the context set by the data. Long vectors are more strongly related to the components being displayed than are short vectors. Long vectors are more important in interpreting the meaning of the components that they are long on.~2%"))
      (show-plot-help))



;=-=-=-=-= obs-list 



    (send obs-list :use-color t)
    (send obs-list :point-color (iseq nobs) 'blue)
    (send obs-list :add-points nvar :point-labels variable-labels)
    (when spin-plot
         (send obs-list :point-color 
               (iseq nobs (- (send spin-plot :num-points) 1)) 'red))
    (send obs-list :linked t)
    (send obs-list :title "Points and Vectors")
    (send (send obs-list :menu) :title "Labels")
    (send obs-list :menu-template '(MOUSE DASH COLOR))
    (send obs-list :new-menu)
    
    (defmeth obs-list :update-plotcell (i j args)
      (when (and (= i 1) (= j 1))
            (send self :point-state (iseq nobs) (first args))))


    (defmeth obs-list :adjust-points-in-rect (&rest args)
       (apply #'call-next-method args)
       (send sp :update-spreadplot 
             1 0 (send self :point-state (iseq nobs)) (send self :mouse-mode))
       )

    (defmeth obs-list :do-brush-click (&rest args)
      (send sp :update-spreadplot 1 0 nil 0)
      (apply #'call-next-method args)
      )

    (defmeth obs-list :set-selection-color ()
      (call-next-method)
      (send self :point-color (first (send self :selection)))
      (send sp :update-spreadplot 1 0 (send self :point-state (iseq nobs)) 
            'color
             (send self :point-color (first (send self :selection)))))

    (send obs-list :fix-name-list)

;=-=-=-=-= boxplot 



  ;  (send boxplot :add-slot 'prev-link-state (send boxplot :linked))
  ;  (defmeth boxplot :prev-link-state (&optional (logical nil set))
  ;    (if set (setf (slot-value 'prev-link-state) logical))
  ;    (slot-value 'prev-link-state))
    (send boxplot :new-menu "BoxPlot" 
              :items '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH  
                            SYMBOL COLOR dash print save copy ))


    (send boxplot :use-color t)
    (send boxplot :linked nil)
    (send boxplot :showing-labels t)
    (send boxplot :connect-points t)
    (send boxplot :mouse-mode 'brushing)

    (defmeth boxplot :update-plotcell (i j args)
      (when (and (= i 0) (= j 0));when coming from scatmat
            (let* ((var-nums (remove-duplicates (first args)))
                   (num-vars (length var-nums))
                   (my-args (second args))
                   (var-labs (remove-duplicates (first my-args) :test 'equal))
                   (select-order
                    (combine (sort-and-permute 
                              var-nums (matrix (list num-vars 1) 
                                               (iseq num-vars)))))
                   (var-labs (select var-labs select-order))
                   (data (select (second my-args) select-order)))
              (when (= (length var-labs) 1)
                    (setf data (list (first data))))
              (send self :new-plot data :variable-labels var-labs)))
      (when (or (and (= i 0) (= j 4));when scatmat select/brush mouse-mode
                (and (= i 0) (= j 1));spinplot
                (and (= i 0) (= j 2));scatterplot
                (and (= i 1) (= j 0)));list-obs
            (cond
              ((first args)
               (let* ((hilited 
                       (which (map-elements #'eq 'hilited (first args))))
                      (selected 
                       (which (map-elements #'eq 'selected (first args))))
                      (normal 
                       (which (map-elements #'eq 'normal (first args))))
                      (mode (second args))
                      (states (remove-duplicates (first args) :test 'equal))
                      )
                 (when (equal mode 'brushing)
                       (if selected
                           (send self :adjust-points  
                                 selected 'selected  mode)
                           (send self :adjust-points  
                                 hilited  'hilited  mode))
                       )
                 (when (equal mode 'selecting)
                       (when (and (= 1 (length states)) 
                                  (equal (first states) 'normal))
                             (send self :point-state 
                                   (iseq (send self :num-points)) 'normal)
                             (send self :adjust-points 
                                   (first args) 'normal mode))
                       (send self :adjust-points  
                             normal   'normal   mode)
                       (send self :adjust-points 
                             selected 'selected mode)
                       )
                 
                 (when (equal mode 'color)
                       (send self :point-color  selected (third args))
                       (send self :propagate-selection
                             selected 'selected nobs nvar 
                             'selecting :color (third args)))
                 (when (equal mode 'symbol)
                       (send self :point-symbol selected (third args))
                       (send self :propagate-selection
                             selected 'selected nobs nvar 
                             'selecting :symbol (third args)))
                 ))
              (t
               (send self :unselect-all-points)
               (send self :change-plot)
               ))
            ))

     (defmeth boxplot :adjust-points-in-rect (&rest args)
       (apply #'call-next-method args)
       (send sp :update-spreadplot 1 1 (send self :point-state (iseq nobs)))
       )

    (send boxplot :point-color (iseq (send boxplot :num-points)) 'blue)



;=-=-=-=-= scree 



    (send scree :variable-label 1 "Proportion")
    (send scree :range 1 0 
          (/ (ceiling (* 10 (select proportions 0))) 10) )      
    (send scree :menu-template 
      '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH SYMBOL COLOR dash print save copy ))
    (send scree :new-menu)
    (send scree :plot-buttons :mouse-mode nil :new-x nil :new-y nil)
    (send sp :show-spreadplot)
    t))